home *** CD-ROM | disk | FTP | other *** search
/ NeXTSTEP 3.3 (Developer)…68k, x86, SPARC, PA-RISC] / NeXTSTEP 3.3 Dev Intel.iso / NextDeveloper / Source / GNU / emacs / src / x11fns.c < prev    next >
C/C++ Source or Header  |  1992-07-15  |  26KB  |  1,020 lines
  1. /* Functions for the X window system.
  2.    Copyright (C) 1988, 1990, 1992 Free Software Foundation.
  3.  
  4. This file is part of GNU Emacs.
  5.  
  6. GNU Emacs is free software; you can redistribute it and/or modify
  7. it under the terms of the GNU General Public License as published by
  8. the Free Software Foundation; either version 1, or (at your option)
  9. any later version.
  10.  
  11. GNU Emacs is distributed in the hope that it will be useful,
  12. but WITHOUT ANY WARRANTY; without even the implied warranty of
  13. MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  14. GNU General Public License for more details.
  15.  
  16. You should have received a copy of the GNU General Public License
  17. along with GNU Emacs; see the file COPYING.  If not, write to
  18. the Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA.  */
  19.  
  20. /* Written by Yakim Martillo; rearranged by Richard Stallman.  */
  21. /* Color and other features added by Robert Krawitz*/
  22. /* Converted to X11 by Robert French */
  23.  
  24. #include <stdio.h>
  25. #include <signal.h>
  26. #include "config.h"
  27.  
  28. /* Get FIONREAD, if it is available.  */
  29. #ifdef USG
  30. #include <termio.h>
  31. #endif /* USG */
  32. #include <fcntl.h>
  33.  
  34. #ifndef VMS
  35. #include <sys/ioctl.h>
  36. #endif /* not VMS */
  37.  
  38. /* Allow m- file to inhibit use of interrupt-driven input.  */
  39. #ifdef BROKEN_FIONREAD
  40. #undef FIONREAD
  41. #endif
  42.  
  43. /* We are unable to use interrupts if FIONREAD is not available,
  44.    so flush SIGIO so we won't try.  */
  45. #ifndef FIONREAD
  46. #ifdef SIGIO
  47. #undef SIGIO
  48. #endif
  49. #endif
  50.  
  51. #include "x11term.h"
  52. #include "dispextern.h"
  53. #include "termchar.h"
  54.  
  55. #ifdef HAVE_SOCKETS
  56. #include <sys/socket.h>        /* Must be done before gettime.h.  */
  57. #endif
  58. /* Include time.h or sys/time.h or both.  */
  59. #include "gettime.h"
  60. #include <setjmp.h>
  61.  
  62. /* Prepare for lisp.h definition of NULL.
  63.    Sometimes x11term.h includes stddef.h.  */
  64. #ifdef NULL
  65. #undef NULL
  66. #endif
  67.  
  68. #include "lisp.h"
  69. #include "window.h"
  70.  
  71. #ifdef HAVE_X_WINDOWS
  72.  
  73. #define abs(x) ((x < 0) ? ((x)) : (x))
  74. #define sgn(x) ((x < 0) ? (-1) : (1))
  75. #define min(a,b) ((a) < (b) ? (a) : (b))
  76. #define max(a,b) ((a) > (b) ? (a) : (b))
  77.   
  78. /* Non-nil if Emacs is running with an X window for display.
  79.    Nil if Emacs is run on an ordinary terminal.  */
  80.  
  81. Lisp_Object Vxterm;
  82.  
  83. Lisp_Object Vx_mouse_pos;
  84. Lisp_Object Vx_mouse_abs_pos;
  85.  
  86. Lisp_Object Vx_mouse_item;
  87.  
  88. /* These are standard "white" and "black" strings, used in the
  89.    *_color variables when the color was not specially allocated for them.  */
  90. char *white_color = "white";
  91. char *black_color = "black";
  92.  
  93. extern Lisp_Object MouseMap;
  94.  
  95. extern Lisp_Object minibuf_window;
  96. extern int minibuf_prompt_width;
  97.  
  98. extern XEvent *XXm_queue[XMOUSEBUFSIZE];
  99. extern int XXm_queue_num;
  100. extern int XXm_queue_in;
  101. extern int XXm_queue_out;
  102. extern char *fore_color;
  103. extern char *back_color;
  104. extern char *brdr_color;
  105. extern char *mous_color;
  106. extern char *curs_color;
  107.  
  108. extern unsigned long fore;
  109. extern unsigned long back;
  110. extern unsigned long brdr;
  111. extern unsigned long curs;
  112.  
  113. extern int XXborder;
  114. extern int XXInternalBorder;
  115.  
  116. extern char *progname;
  117.  
  118. extern XFontStruct *fontinfo;
  119. extern Font XXfid;
  120. extern GC XXgc_norm,XXgc_rev,XXgc_curs,XXgc_temp,XXgc_curs_rev;
  121. extern XGCValues XXgcv;
  122. extern int XXfontw,XXfonth,XXbase,XXisColor;
  123. extern Colormap XXColorMap;
  124.  
  125. extern int PendingExposure;
  126. extern char *default_window;
  127. extern char *desiredwindow;
  128.  
  129. extern int XXscreen;
  130. extern Window XXwindow;
  131. extern Cursor EmacsCursor;
  132. extern short MouseCursor[], MouseMask[];
  133. extern char *XXcurrentfont;
  134. extern int informflag;
  135.  
  136. extern int WindowMapped;
  137. extern int CurHL;
  138. extern int pixelwidth, pixelheight;
  139. extern int XXpid;
  140.  
  141. extern char *XXidentity;
  142.  
  143. extern Display *XXdisplay;
  144. extern int bitblt, CursorExists, VisibleX, VisibleY;
  145.  
  146. check_xterm ()
  147. {
  148.     if (NULL (Vxterm))
  149.         error ("Terminal does not understand X protocol.");
  150. }
  151.  
  152. DEFUN ("x-set-bell", Fx_set_bell, Sx_set_bell, 1, 1, "P",
  153.   "For X window system, set audible vs visible bell.\n\
  154. With non-nil argument (prefix arg), use visible bell; otherwise, audible bell.")
  155.    (arg)
  156.      Lisp_Object arg;
  157. {
  158.     BLOCK_INPUT_DECLARE ();
  159.  
  160.     check_xterm ();
  161.     BLOCK_INPUT ();
  162.     if (!NULL (arg))
  163.         XSetFlash ();
  164.     else
  165.         XSetFeep ();
  166.     UNBLOCK_INPUT ();
  167.     return arg;
  168. }
  169.  
  170. DEFUN ("x-flip-color", Fx_flip_color, Sx_flip_color, 0, 0, "",
  171.   "Toggle the background and foreground colors")
  172.   ()
  173. {
  174.     check_xterm ();
  175.     XFlipColor ();
  176.     return Qt;
  177. }
  178.  
  179. DEFUN ("x-set-foreground-color", Fx_set_foreground_color,
  180.        Sx_set_foreground_color, 1, 1, "sSet foreground color:  ",
  181.        "Set foreground (text) color to COLOR.")
  182.   (arg)
  183.      Lisp_Object arg;
  184. {
  185.     XColor cdef;
  186.     BLOCK_INPUT_DECLARE ();
  187.     char *save_color;
  188.     unsigned long save;
  189.  
  190.     save_color = fore_color;
  191.     save = fore;
  192.     check_xterm ();
  193.     CHECK_STRING (arg,1);
  194.     fore_color = (char *) xmalloc (XSTRING (arg)->size + 1);
  195.     bcopy (XSTRING (arg)->data, fore_color, XSTRING (arg)->size + 1);
  196.  
  197.     BLOCK_INPUT ();
  198.  
  199.     if (fore_color && XXisColor &&
  200.         XParseColor (XXdisplay, XXColorMap, fore_color, &cdef) &&
  201.         XAllocColor(XXdisplay, XXColorMap, &cdef))
  202.       fore = cdef.pixel;
  203.     else if (fore_color && !strcmp (fore_color, "white"))
  204.       fore = WhitePixel (XXdisplay, XXscreen), fore_color = white_color;
  205.     else if (fore_color && !strcmp (fore_color, "black"))
  206.       fore = BlackPixel (XXdisplay, XXscreen), fore_color = black_color;
  207.     else
  208.       fore_color = save_color;
  209.  
  210.     /* Now free the old background color
  211.        if it was specially allocated and we are not still using it.  */
  212.     if (save_color != white_color && save_color != black_color
  213.         && save_color != fore_color)
  214.       {
  215.         XFreeColors (XXdisplay, XXColorMap, &save, 1, 0);
  216.         free (save_color);
  217.       }
  218.  
  219.     XSetForeground(XXdisplay, XXgc_norm, fore);
  220.     XSetBackground(XXdisplay, XXgc_rev, fore);
  221.     
  222.     Fredraw_display ();
  223.     UNBLOCK_INPUT ();
  224.  
  225.     XFlush (XXdisplay);
  226.     return Qt;
  227. }
  228.  
  229. DEFUN ("x-set-background-color", Fx_set_background_color,
  230.        Sx_set_background_color, 1, 1, "sSet background color: ",
  231.        "Set background color to COLOR.")
  232.   (arg)
  233.      Lisp_Object arg;
  234. {
  235.     XColor cdef;
  236.     BLOCK_INPUT_DECLARE ();
  237.     char *save_color;
  238.     unsigned long save;
  239.  
  240.     check_xterm ();
  241.     CHECK_STRING (arg,1);
  242.     save_color = back_color;
  243.     save = back;
  244.     back_color = (char *) xmalloc (XSTRING (arg)->size + 1);
  245.     bcopy (XSTRING (arg)->data, back_color, XSTRING (arg)->size + 1);
  246.  
  247.     BLOCK_INPUT ();
  248.  
  249.     if (back_color && XXisColor &&
  250.         XParseColor (XXdisplay, XXColorMap, back_color, &cdef) &&
  251.         XAllocColor(XXdisplay, XXColorMap, &cdef))
  252.       back = cdef.pixel;
  253.     else if (back_color && !strcmp (back_color, "white"))
  254.       back = WhitePixel (XXdisplay, XXscreen), back_color = white_color;
  255.     else if (back_color && !strcmp (back_color, "black"))
  256.       back = BlackPixel (XXdisplay, XXscreen), back_color = black_color;
  257.     else
  258.       back_color = save_color;
  259.  
  260.     /* Now free the old background color
  261.        if it was specially allocated and we are not still using it.  */
  262.     if (save_color != white_color && save_color != black_color
  263.         && save_color != back_color)
  264.       {
  265.         XFreeColors (XXdisplay, XXColorMap, &save, 1, 0);
  266.         free (save_color);
  267.       }
  268.  
  269.     XSetBackground (XXdisplay, XXgc_norm, back);
  270.     XSetForeground (XXdisplay, XXgc_rev, back);
  271.     XSetForeground (XXdisplay, XXgc_curs, back);
  272.     XSetBackground (XXdisplay, XXgc_curs_rev, back);
  273.     XSetWindowBackground(XXdisplay, XXwindow, back);
  274.     XClearArea (XXdisplay, XXwindow, 0, 0,
  275.             screen_width*XXfontw+2*XXInternalBorder,
  276.             screen_height*XXfonth+2*XXInternalBorder, 0);
  277.     
  278.     UNBLOCK_INPUT ();
  279.     Fredraw_display ();
  280.  
  281.     XFlush (XXdisplay);
  282.     return Qt;
  283. }
  284.  
  285. DEFUN ("x-set-border-color", Fx_set_border_color, Sx_set_border_color, 1, 1,
  286.        "sSet border color: ",
  287.        "Set border color to COLOR.")
  288.   (arg)
  289.      Lisp_Object arg;
  290. {
  291.     XColor cdef;
  292.     BLOCK_INPUT_DECLARE ();
  293.     unsigned long save;
  294.     char *save_color;
  295.  
  296.     check_xterm ();
  297.     CHECK_STRING (arg,1);
  298.     brdr_color= (char *) xmalloc (XSTRING (arg)->size + 1);
  299.     save = brdr;
  300.     save_color = brdr_color;
  301.     bcopy (XSTRING (arg)->data, brdr_color, XSTRING (arg)->size + 1);
  302.  
  303.     BLOCK_INPUT ();
  304.  
  305.     if (brdr_color && XXisColor &&
  306.         XParseColor (XXdisplay, XXColorMap, brdr_color, &cdef) &&
  307.         XAllocColor(XXdisplay, XXColorMap, &cdef))
  308.       brdr = cdef.pixel;
  309.     else
  310.       {
  311.         if (brdr_color && !strcmp (brdr_color, "black"))
  312.           {
  313.         brdr = BlackPixel (XXdisplay, XXscreen);
  314.         brdr_color = black_color;
  315.           }
  316.         else
  317.           if (brdr_color && !strcmp (brdr_color, "white"))
  318.         {
  319.           brdr = WhitePixel (XXdisplay, XXscreen);
  320.           brdr_color = white_color;
  321.         }
  322.           else {
  323.         brdr_color = black_color;
  324.         brdr = BlackPixel (XXdisplay, XXscreen);
  325.           }
  326.       }
  327.  
  328.     /* Now free the old background color
  329.        if it was specially allocated and we are not still using it.  */
  330.     if (save_color != white_color && save_color != black_color
  331.         && save_color != brdr_color)
  332.       {
  333.         XFreeColors (XXdisplay, XXColorMap, &save, 1, 0);
  334.         free (save_color);
  335.       }
  336.  
  337.     if (XXborder) {
  338.         XSetWindowBorder(XXdisplay, XXwindow, brdr);
  339.         XFlush (XXdisplay);
  340.     }
  341.     
  342.     UNBLOCK_INPUT ();
  343.  
  344.     return Qt;
  345. }
  346.  
  347. DEFUN ("x-set-cursor-color", Fx_set_cursor_color, Sx_set_cursor_color, 1, 1,
  348.        "sSet text cursor color: ",
  349.        "Set text cursor color to COLOR.")
  350.   (arg)
  351.      Lisp_Object arg;
  352. {
  353.     XColor cdef;
  354.     BLOCK_INPUT_DECLARE ();
  355.     char *save_color;
  356.     unsigned long save;
  357.  
  358.     check_xterm ();
  359.     CHECK_STRING (arg,1);
  360.     save_color = curs_color;
  361.     save = curs;
  362.     curs_color = (char *) xmalloc (XSTRING (arg)->size + 1);
  363.     bcopy (XSTRING (arg)->data, curs_color, XSTRING (arg)->size + 1);
  364.  
  365.     BLOCK_INPUT ();
  366.  
  367.     if (curs_color && XXisColor &&
  368.         XParseColor (XXdisplay, XXColorMap, curs_color, &cdef) &&
  369.         XAllocColor(XXdisplay, XXColorMap, &cdef))
  370.       curs = cdef.pixel;
  371.     else if (curs_color && !strcmp (curs_color, "white"))
  372.       curs = WhitePixel (XXdisplay, XXscreen), curs_color = white_color;
  373.     else if (curs_color && !strcmp (curs_color, "black"))
  374.       curs = BlackPixel (XXdisplay, XXscreen), curs_color = black_color;
  375.     else
  376.       curs_color = save_color;
  377.  
  378.     /* Now free the old background color
  379.        if it was specially allocated and we are not still using it.  */
  380.     if (save_color != white_color && save_color != black_color
  381.         && save_color != curs_color)
  382.       {
  383.         XFreeColors (XXdisplay, XXColorMap, &save, 1, 0);
  384.         free (save_color);
  385.       }
  386.  
  387.     XSetBackground(XXdisplay, XXgc_curs, curs);
  388.     XSetForeground(XXdisplay, XXgc_curs_rev, curs);
  389.  
  390.     CursorToggle ();
  391.     CursorToggle ();
  392.  
  393.     UNBLOCK_INPUT ();
  394.     return Qt;
  395. }
  396.  
  397. DEFUN ("x-set-mouse-color", Fx_set_mouse_color, Sx_set_mouse_color, 1, 1,
  398.        "sSet mouse cursor color: ",
  399.        "Set mouse cursor color to COLOR.")
  400.   (arg)
  401.      Lisp_Object arg;
  402. {
  403.   BLOCK_INPUT_DECLARE ();
  404.   char *save_color;
  405.  
  406.   check_xterm ();
  407.   CHECK_STRING (arg,1);
  408.   save_color = mous_color;
  409.   mous_color = (char *) xmalloc (XSTRING (arg)->size + 1);
  410.   bcopy (XSTRING (arg)->data, mous_color, XSTRING (arg)->size + 1);
  411.  
  412.   BLOCK_INPUT ();
  413.  
  414.   if (! x_set_cursor_colors ())
  415.     mous_color = save_color;
  416.   else if (save_color != white_color && save_color != black_color
  417.        && save_color != mous_color)
  418.     free (save_color);
  419.  
  420.   XFlush (XXdisplay);
  421.     
  422.   UNBLOCK_INPUT ();
  423.   return Qt;
  424. }   
  425.  
  426. /* Set the actual X cursor colors from `mous_color' and `back_color'.  */
  427.  
  428. int
  429. x_set_cursor_colors ()
  430. {
  431.   XColor forec, backc;
  432.  
  433.   char     *useback;
  434.  
  435.   /* USEBACK is the background color, but on monochrome screens
  436.      changed if necessary not to match the mouse.  */
  437.  
  438.   useback = back_color;
  439.  
  440.   if (!XXisColor && !strcmp (mous_color, back_color))
  441.     {
  442.       if (strcmp (back_color, "white"))
  443.     useback = white_color;
  444.       else
  445.     useback = black_color;
  446.     }
  447.  
  448.   if (XXisColor && mous_color
  449.       && XParseColor (XXdisplay, XXColorMap, mous_color, &forec)
  450.       && XParseColor (XXdisplay, XXColorMap, useback, &backc))
  451.     {
  452.       XRecolorCursor (XXdisplay, EmacsCursor, &forec, &backc);
  453.       return 1;
  454.     }
  455.   else return 0;
  456. }
  457.  
  458. DEFUN ("x-color-p", Fx_color_p, Sx_color_p, 0, 0, 0,
  459.        "Returns t if the display is a color X terminal.")
  460.   ()
  461. {
  462.     check_xterm ();
  463.  
  464.     if (XXisColor)
  465.         return Qt;
  466.     else
  467.         return Qnil;
  468. }
  469.     
  470. DEFUN ("x-get-foreground-color", Fx_get_foreground_color,
  471.        Sx_get_foreground_color, 0, 0, 0,
  472.        "Returns the color of the foreground, as a string.")
  473.   ()
  474. {
  475.     Lisp_Object string;
  476.  
  477.     check_xterm ();
  478.     string = build_string (fore_color);
  479.     return string;
  480. }
  481.  
  482. DEFUN ("x-get-background-color", Fx_get_background_color,
  483.        Sx_get_background_color, 0, 0, 0,
  484.        "Returns the color of the background, as a string.")
  485.   ()
  486. {
  487.     Lisp_Object string;
  488.  
  489.     check_xterm ();
  490.     string = build_string (back_color);
  491.     return string;
  492. }
  493.  
  494. DEFUN ("x-get-border-color", Fx_get_border_color,
  495.        Sx_get_border_color, 0, 0, 0,
  496.        "Returns the color of the border, as a string.")
  497.   ()
  498. {
  499.     Lisp_Object string;
  500.  
  501.     check_xterm ();
  502.     string = build_string (brdr_color);
  503.     return string;
  504. }
  505.  
  506. DEFUN ("x-get-cursor-color", Fx_get_cursor_color,
  507.        Sx_get_cursor_color, 0, 0, 0,
  508.        "Returns the color of the cursor, as a string.")
  509.   ()
  510. {
  511.     Lisp_Object string;
  512.  
  513.     check_xterm ();
  514.     string = build_string (curs_color);
  515.     return string;
  516. }
  517.  
  518. DEFUN ("x-get-mouse-color", Fx_get_mouse_color,
  519.        Sx_get_mouse_color, 0, 0, 0,
  520.        "Returns the color of the mouse cursor, as a string.")
  521.   ()
  522. {
  523.     Lisp_Object string;
  524.  
  525.     check_xterm ();
  526.     string = build_string (mous_color);
  527.     return string;
  528. }
  529.  
  530. DEFUN ("x-get-default", Fx_get_default, Sx_get_default, 1, 1, 0,
  531.        "Get default for X-window attribute ATTRIBUTE from the system.\n\
  532. ATTRIBUTE must be a string.\n\
  533. Returns nil if attribute default isn't specified.")
  534.   (arg)
  535.      Lisp_Object arg;
  536. {
  537.     char *default_name, *value;
  538.  
  539.     check_xterm ();
  540.     CHECK_STRING (arg, 1);
  541.     default_name = (char *) XSTRING (arg)->data;
  542.  
  543. #ifdef XBACKWARDS
  544.     /* Some versions of X11R4, at least, have the args backwards.  */
  545.     if (XXidentity && *XXidentity)
  546.         value = XGetDefault (XXdisplay, default_name, XXidentity);
  547.     else
  548.         value = XGetDefault (XXdisplay, default_name, CLASS);
  549. #else
  550.     if (XXidentity && *XXidentity)
  551.         value = XGetDefault (XXdisplay, XXidentity, default_name);
  552.     else
  553.         value = XGetDefault (XXdisplay, CLASS, default_name);
  554. #endif
  555.      
  556.     if (value)
  557.         return build_string (value);
  558.     return (Qnil);
  559. }
  560.  
  561. DEFUN ("x-set-font", Fx_set_font, Sx_set_font, 1, 1, "sFont Name: ",
  562.       "Sets the font to be used for the X window.")
  563.   (arg)
  564.      Lisp_Object arg;
  565. {
  566.     register char *newfontname;
  567.     
  568.     CHECK_STRING (arg, 1);
  569.     check_xterm ();
  570.  
  571.     newfontname = (char *) xmalloc (XSTRING (arg)->size + 1);
  572.     bcopy (XSTRING (arg)->data, newfontname, XSTRING (arg)->size + 1);
  573.     if (XSTRING (arg)->size == 0)
  574.         goto badfont;
  575.  
  576.     if (!XNewFont (newfontname)) {
  577.         free (XXcurrentfont);
  578.         XXcurrentfont = newfontname;
  579.         return Qt;
  580.     }
  581. badfont:
  582.     error ("Font \"%s\" is not defined", newfontname);
  583.     free (newfontname);
  584.  
  585.     return Qnil;
  586. }
  587.  
  588. DEFUN ("coordinates-in-window-p", Fcoordinates_in_window_p,
  589.   Scoordinates_in_window_p, 2, 2, 0,
  590.   "Return non-nil if POSITIONS (a list, (SCREEN-X SCREEN-Y)) is in WINDOW.\n\
  591. Returned value is list of positions expressed\n\
  592. relative to window upper left corner.")
  593.   (coordinate, window)
  594.      register Lisp_Object coordinate, window;
  595. {
  596.     register Lisp_Object xcoord, ycoord;
  597.     int height;
  598.     
  599.     if (!CONSP (coordinate))
  600.         wrong_type_argument (Qlistp, coordinate);
  601.  
  602.     CHECK_WINDOW (window, 2);
  603.     xcoord = Fcar (coordinate);
  604.     ycoord = Fcar (Fcdr (coordinate));
  605.     CHECK_NUMBER (xcoord, 0);
  606.     CHECK_NUMBER (ycoord, 1);
  607.     if ((XINT (xcoord) < XINT (XWINDOW (window)->left)) ||
  608.         (XINT (xcoord) >= (XINT (XWINDOW (window)->left) +
  609.                    XINT (XWINDOW (window)->width))))
  610.         return Qnil;
  611.  
  612.     XFASTINT (xcoord) -= XFASTINT (XWINDOW (window)->left);
  613.  
  614.     height = XINT (XWINDOW (window)->height);
  615.  
  616.     if (window != minibuf_window)
  617.       height --;
  618.  
  619.     if ((XINT (ycoord) < XINT (XWINDOW (window)->top)) ||
  620.         (XINT (ycoord) >= XINT (XWINDOW (window)->top) + height))
  621.       return Qnil;
  622.  
  623.     XFASTINT (ycoord) -= XFASTINT (XWINDOW (window)->top);
  624.     return Fcons (xcoord, Fcons (ycoord, Qnil));
  625. }
  626.  
  627. DEFUN ("x-mouse-events", Fx_mouse_events, Sx_mouse_events, 0, 0, 0,
  628.   "Return number of pending mouse events from X window system.")
  629.   ()
  630. {
  631.     register Lisp_Object tem;
  632.  
  633.     check_xterm ();
  634.  
  635.     XSET (tem, Lisp_Int, XXm_queue_num);
  636.     
  637.     return tem;
  638. }
  639.  
  640. DEFUN ("x-proc-mouse-event", Fx_proc_mouse_event, Sx_proc_mouse_event,
  641.   0, 0, 0,
  642.   "Pulls a mouse event out of the mouse event buffer and dispatches\n\
  643. the appropriate function to act upon this event.")
  644.   ()
  645. {
  646.     XEvent event;
  647.     register Lisp_Object mouse_cmd;
  648.     register char com_letter;
  649.     register char key_mask;
  650.     register Lisp_Object tempx;
  651.     register Lisp_Object tempy;
  652.     extern Lisp_Object get_keyelt ();
  653.     extern int meta_prefix_char;
  654.     
  655.     check_xterm ();
  656.  
  657.     if (XXm_queue_num) {
  658.         event = *XXm_queue[XXm_queue_out];
  659.         free (XXm_queue[XXm_queue_out]);
  660.         XXm_queue_out = (XXm_queue_out + 1) % XMOUSEBUFSIZE;
  661.         XXm_queue_num--;
  662.         com_letter = 3-(event.xbutton.button & 3);
  663.         key_mask = (event.xbutton.state & 15) << 4;
  664.         /* Get rid of the shift-lock bit.  */
  665.         key_mask &= ~0x20;
  666.         /* Report meta in 2 bit, not in 8 bit.  */
  667.         if (key_mask & 0x80)
  668.           {
  669.             key_mask |= 0x20;
  670.             key_mask &= ~0x80;
  671.           }
  672.         com_letter |= key_mask;
  673.         if (event.type == ButtonRelease)
  674.             com_letter |= 0x04;
  675.         XSET (tempx, Lisp_Int,
  676.               min (screen_width-1,
  677.                max (0, (event.xbutton.x-XXInternalBorder)/
  678.                 XXfontw)));
  679.         XSET (tempy, Lisp_Int,
  680.               min (screen_height-1,
  681.                max (0, (event.xbutton.y-XXInternalBorder)/
  682.                 XXfonth)));
  683.         Vx_mouse_pos = Fcons (tempx, Fcons (tempy, Qnil));
  684.         XSET (tempx, Lisp_Int, event.xbutton.x_root);
  685.         XSET (tempy, Lisp_Int, event.xbutton.y_root);
  686.         Vx_mouse_abs_pos = Fcons (tempx, Fcons (tempy, Qnil));
  687.         Vx_mouse_item = make_number (com_letter);
  688.         mouse_cmd
  689.           = get_keyelt (access_keymap (MouseMap, com_letter));
  690.         if (NULL (mouse_cmd)) {
  691.             if (event.type != ButtonRelease)
  692.                 bell ();
  693.             Vx_mouse_pos = Qnil;
  694.         }
  695.         else
  696.             return call1 (mouse_cmd, Vx_mouse_pos);
  697.     }
  698.     return Qnil;
  699. }
  700.  
  701. DEFUN ("x-get-mouse-event", Fx_get_mouse_event, Sx_get_mouse_event,
  702.   1, 1, 0,
  703.   "Get next mouse event out of mouse event buffer (com-letter (x y)).\n\
  704. ARG non-nil means return nil immediately if no pending event;\n\
  705. otherwise, wait for an event.")
  706.   (arg)
  707.      Lisp_Object arg;
  708. {
  709.     XEvent event;
  710.     register char com_letter;
  711.     register char key_mask;
  712.  
  713.     register Lisp_Object tempx;
  714.     register Lisp_Object tempy;
  715.     
  716.     check_xterm ();
  717.  
  718.     if (NULL (arg))
  719.         while (!XXm_queue_num)
  720.           {
  721.             consume_available_input ();
  722.             Fsleep_for (make_number (1));
  723.           }
  724.     /*** ??? Surely you don't mean to busy wait??? */
  725.  
  726.     if (XXm_queue_num) {
  727.         event = *XXm_queue[XXm_queue_out];
  728.         free (XXm_queue[XXm_queue_out]);
  729.         XXm_queue_out = (XXm_queue_out + 1) % XMOUSEBUFSIZE;
  730.         XXm_queue_num--;
  731.         com_letter = 3-(event.xbutton.button & 3);
  732.         key_mask = (event.xbutton.state & 15) << 4;
  733.         /* Report meta in 2 bit, not in 8 bit.  */
  734.         if (key_mask & 0x80)
  735.           {
  736.             key_mask |= 0x20;
  737.             key_mask &= ~0x80;
  738.           }
  739.         com_letter |= key_mask;
  740.         if (event.type == ButtonRelease)
  741.             com_letter |= 0x04;
  742.         XSET (tempx, Lisp_Int,
  743.               min (screen_width-1,
  744.                max (0, (event.xbutton.x-XXInternalBorder)/
  745.                 XXfontw)));
  746.         XSET (tempy, Lisp_Int,
  747.               min (screen_height-1,
  748.                max (0, (event.xbutton.y-XXInternalBorder)/
  749.                 XXfonth)));
  750.         Vx_mouse_pos = Fcons (tempx, Fcons (tempy, Qnil));
  751.         XSET (tempx, Lisp_Int, event.xbutton.x_root);
  752.         XSET (tempy, Lisp_Int, event.xbutton.y_root);
  753.         Vx_mouse_abs_pos = Fcons (tempx, Fcons (tempy, Qnil));
  754.         Vx_mouse_item = make_number (com_letter);
  755.         return Fcons (com_letter, Fcons (Vx_mouse_pos, Qnil));
  756.     }
  757.     return Qnil;
  758. }
  759.  
  760. DEFUN ("x-store-cut-buffer", Fx_store_cut_buffer, Sx_store_cut_buffer,
  761.   1, 1, "sSend string to X:",
  762.   "Store contents of STRING into the cut buffer of the X window system.")
  763.   (string)
  764.      register Lisp_Object string;
  765. {
  766.     BLOCK_INPUT_DECLARE ();
  767.  
  768.     CHECK_STRING (string, 1);
  769.     check_xterm ();
  770.  
  771.     BLOCK_INPUT ();
  772.     XStoreBytes (XXdisplay, (char *) XSTRING (string)->data,
  773.              XSTRING (string)->size);
  774.     /* Clear the selection owner, so that other applications
  775.        will use the cut buffer rather than a selection.  */
  776.         XSetSelectionOwner (XXdisplay, XA_PRIMARY, None, CurrentTime);
  777.     UNBLOCK_INPUT ();
  778.  
  779.     return Qnil;
  780. }
  781.  
  782. DEFUN ("x-get-cut-buffer", Fx_get_cut_buffer, Sx_get_cut_buffer, 0, 0, 0,
  783.   "Return contents of cut buffer of the X window system, as a string.")
  784.   ()
  785. {
  786.     int len;
  787.     register Lisp_Object string;
  788.     BLOCK_INPUT_DECLARE ();
  789.     register char *d;
  790.  
  791.     check_xterm ();
  792.     BLOCK_INPUT ();
  793.     d = XFetchBytes (XXdisplay, &len);
  794.     string = make_string (d, len);
  795.     UNBLOCK_INPUT ();
  796.  
  797.     return string;
  798. }
  799.  
  800. DEFUN ("x-set-border-width", Fx_set_border_width, Sx_set_border_width,
  801.   1, 1, "nBorder width: ",
  802.   "Set width of border to WIDTH, in the X window system.")
  803.   (borderwidth)
  804.      register Lisp_Object borderwidth;
  805. {
  806.     BLOCK_INPUT_DECLARE ();
  807.  
  808.     CHECK_NUMBER (borderwidth, 0);
  809.  
  810.     check_xterm ();
  811.   
  812.     if (XINT (borderwidth) < 0)
  813.         XSETINT (borderwidth, 0);
  814.   
  815.     BLOCK_INPUT ();
  816.     XSetWindowBorderWidth(XXdisplay, XXwindow, XINT(borderwidth));
  817.     XFlush(XXdisplay);
  818.     UNBLOCK_INPUT ();
  819.  
  820.     return Qt;
  821. }
  822.  
  823.  
  824. DEFUN ("x-set-internal-border-width", Fx_set_internal_border_width,
  825.        Sx_set_internal_border_width, 1, 1, "nInternal border width: ",
  826.   "Set width of internal border to WIDTH, in the X window system.")
  827.   (internalborderwidth)
  828.      register Lisp_Object internalborderwidth;
  829. {
  830.     BLOCK_INPUT_DECLARE ();
  831.  
  832.     CHECK_NUMBER (internalborderwidth, 0);
  833.  
  834.     check_xterm ();
  835.   
  836.     if (XINT (internalborderwidth) < 0)
  837.         XSETINT (internalborderwidth, 0);
  838.  
  839.     BLOCK_INPUT ();
  840.     XXInternalBorder = XINT(internalborderwidth);
  841.     XSetWindowSize(screen_height,screen_width);
  842.     UNBLOCK_INPUT ();
  843.  
  844.     return Qt;
  845. }
  846.  
  847. #ifdef foobar
  848. DEFUN ("x-rebind-key", Fx_rebind_key, Sx_rebind_key, 3, 3, 0,
  849.   "Rebind KEYCODE, with shift bits SHIFT-MASK, to new string NEWSTRING.\n\
  850. KEYCODE and SHIFT-MASK should be numbers representing the X keyboard code\n\
  851. and shift mask respectively.  NEWSTRING is an arbitrary string of keystrokes.\n\
  852. If SHIFT-MASK is nil, then KEYCODE's key will be bound to NEWSTRING for\n\
  853. all shift combinations.\n\
  854. Shift Lock  1       Shift    2\n\
  855. Meta        4       Control  8\n\
  856. \n\
  857. For values of KEYCODE, see /usr/lib/Xkeymap.txt (remember that the codes\n\
  858. in that file are in octal!)\n")
  859.  
  860.   (keycode, shift_mask, newstring)
  861.      register Lisp_Object keycode;
  862.      register Lisp_Object shift_mask;
  863.      register Lisp_Object newstring;
  864. {
  865. #ifdef notdef
  866.     char *rawstring;
  867.     int rawkey, rawshift;
  868.     int i;
  869.     int strsize;
  870.  
  871.     CHECK_NUMBER (keycode, 1);
  872.     if (!NULL (shift_mask))
  873.         CHECK_NUMBER (shift_mask, 2);
  874.     CHECK_STRING (newstring, 3);
  875.     strsize = XSTRING (newstring) ->size;
  876.     rawstring = (char *) xmalloc (strsize);
  877.     bcopy (XSTRING (newstring)->data, rawstring, strsize);
  878.     rawkey = ((unsigned) (XINT (keycode))) & 255;
  879.     if (NULL (shift_mask))
  880.         for (i = 0; i <= 15; i++)
  881.             XRebindCode (rawkey, i<<11, rawstring, strsize);
  882.     else
  883.     {
  884.         rawshift = (((unsigned) (XINT (shift_mask))) & 15) << 11;
  885.         XRebindCode (rawkey, rawshift, rawstring, strsize);
  886.     }
  887. #endif notdef
  888.     return Qnil;
  889. }
  890.   
  891. DEFUN ("x-rebind-keys", Fx_rebind_keys, Sx_rebind_keys, 2, 2, 0,
  892.   "Rebind KEYCODE to list of strings STRINGS.\n\
  893. STRINGS should be a list of 16 elements, one for each all shift combination.\n\
  894. nil as element means don't change.\n\
  895. See the documentation of x-rebind-key for more information.")
  896.   (keycode, strings)
  897.      register Lisp_Object keycode;
  898.      register Lisp_Object strings;
  899. {
  900. #ifdef notdef
  901.     register Lisp_Object item;
  902.     register char *rawstring;
  903.     int rawkey, strsize;
  904.     register unsigned i;
  905.  
  906.     CHECK_NUMBER (keycode, 1);
  907.     CHECK_CONS (strings, 2);
  908.     rawkey = ((unsigned) (XINT (keycode))) & 255;
  909.     for (i = 0; i <= 15; strings = Fcdr (strings), i++)
  910.     {
  911.         item = Fcar (strings);
  912.         if (!NULL (item))
  913.         {
  914.             CHECK_STRING (item, 2);
  915.             strsize = XSTRING (item)->size;
  916.             rawstring = (char *) xmalloc (strsize);
  917.             bcopy (XSTRING (item)->data, rawstring, strsize);
  918.             XRebindCode (rawkey, i << 11, rawstring, strsize);
  919.         }
  920.     }
  921. #endif notdef
  922.     return Qnil;
  923. }
  924.  
  925. #endif foobar
  926.  
  927. XExitWithCoreDump ()
  928. {
  929.     XCleanUp ();
  930.     abort ();
  931. }
  932.  
  933. DEFUN ("x-debug", Fx_debug, Sx_debug, 1, 1, 0,
  934.   "ARG non-nil means that X errors should generate a coredump.")
  935.   (arg)
  936.      register Lisp_Object arg;
  937. {
  938.     int (*handler)();
  939.  
  940.     check_xterm ();
  941.     if (!NULL (arg))
  942.         handler = XExitWithCoreDump;
  943.     else
  944.     {
  945.         extern int XIgnoreError ();
  946.         handler = XIgnoreError;
  947.     }
  948.     XSetErrorHandler(handler);
  949.     XSetIOErrorHandler(handler);
  950.     return (Qnil);
  951. }
  952.  
  953. XRedrawDisplay ()
  954. {
  955.     Fredraw_display ();
  956. }
  957.  
  958. XCleanUp ()
  959. {
  960.     Fdo_auto_save (Qt);
  961.  
  962. #ifdef subprocesses
  963.     kill_buffer_processes (Qnil);
  964. #endif                /* subprocesses */
  965. }
  966.  
  967. syms_of_xfns ()
  968. {
  969.   /* If not dumping, init_display ran before us, so don't override it.  */
  970. #ifdef CANNOT_DUMP
  971.   if (noninteractive)
  972. #endif
  973.     Vxterm = Qnil;
  974.  
  975.   DEFVAR_LISP ("x-mouse-item", &Vx_mouse_item,
  976.            "Encoded representation of last mouse click, corresponding to\n\
  977. numerical entries in x-mouse-map.");
  978.   Vx_mouse_item = Qnil;
  979.   DEFVAR_LISP ("x-mouse-pos", &Vx_mouse_pos,
  980.            "Current x-y position of mouse by row, column as specified by font.");
  981.   Vx_mouse_pos = Qnil;
  982.   DEFVAR_LISP ("x-mouse-abs-pos", &Vx_mouse_abs_pos,
  983.            "Current x-y position of mouse relative to root window.");
  984.   Vx_mouse_abs_pos = Qnil;
  985.  
  986.   defsubr (&Sx_set_bell);
  987.   defsubr (&Sx_flip_color);
  988.   defsubr (&Sx_set_font);
  989. #ifdef notdef
  990.   defsubr (&Sx_set_icon);
  991. #endif notdef
  992.   defsubr (&Scoordinates_in_window_p);
  993.   defsubr (&Sx_mouse_events);
  994.   defsubr (&Sx_proc_mouse_event);
  995.   defsubr (&Sx_get_mouse_event);
  996.   defsubr (&Sx_store_cut_buffer);
  997.   defsubr (&Sx_get_cut_buffer);
  998.   defsubr (&Sx_set_border_width);
  999.   defsubr (&Sx_set_internal_border_width);
  1000.   defsubr (&Sx_set_foreground_color);
  1001.   defsubr (&Sx_set_background_color);
  1002.   defsubr (&Sx_set_border_color);
  1003.   defsubr (&Sx_set_cursor_color);
  1004.   defsubr (&Sx_set_mouse_color);
  1005.   defsubr (&Sx_get_foreground_color);
  1006.   defsubr (&Sx_get_background_color);
  1007.   defsubr (&Sx_get_border_color);
  1008.   defsubr (&Sx_get_cursor_color);
  1009.   defsubr (&Sx_get_mouse_color);
  1010.   defsubr (&Sx_color_p);
  1011.   defsubr (&Sx_get_default);
  1012. #ifdef notdef
  1013.   defsubr (&Sx_rebind_key);
  1014.   defsubr (&Sx_rebind_keys);
  1015. #endif notdef
  1016.   defsubr (&Sx_debug);
  1017. }
  1018.  
  1019. #endif /* HAVE_X_WINDOWS */
  1020.